home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 23
/
Amiga Format AFCD23 (Feb 1998, Issue 107).iso
/
+look_here_1st!+
/
reader_requests
/
alienbreed3d2
/
amos
/
256obj.amos
/
256obj.amosSourceCode
Wrap
AMOS Source Code
|
1997-11-28
|
4KB
|
153 lines
Screen Open 7,640,24,2,Hires : Wait Vbl : Curs Off : Flash Off : Extension_12_0380 -1
Palette $8,$FF0 : Paper 0 : Pen 1 : Ink 1 : Box 0,4 To 639,20
Reserve As Work 14,640*640+12
'Reserve As Work 13,4096
Reserve As Work 12,40960
Dim CO(63),R(255),G(255),B(255),PR(31),PG(31),PB(31)
Global WOF,HOF,CO(),R(),G(),B(),PR(),PG(),PB()
Trap Bload "ab3:includes/256pal",Start(14)
If Errtrap
Screen To Front 7 : Screen 7
Locate 1,1 : Print Space$(78)
Locate 1,1 : Centre "Unable to load 'ab3:includes/256pal'"
Wait Key
Edit
End If
S=Start(14)
For A=0 To 255
R(A)=Deek(S) : Add S,2
G(A)=Deek(S) : Add S,2
B(A)=Deek(S) : Add S,2
Next
Repeat
F$=Fsel$("ab3:graphics/","","Load Object Graphics")
If F$="" Then Edit
Screen Open 0,640,640,32,Lowres
Curs Off : Flash Off : Cls 0
Wait Vbl
' Load Iff F$,0
Trap Load Iff F$
If Errtrap
Screen To Front 7 : Screen 7
Locate 1,1 : Print Space$(78)
Locate 1,1 : Centre "Unable to load '"+F$+"'"
Wait Key
Edit
End If
Trap Bload F$,Start(14)
If Errtrap
Screen To Front 7 : Screen 7
Locate 1,1 : Print Space$(78)
Locate 1,1 : Centre "Unable to load '"+F$+"'"
Wait Key
Edit
End If
S=Hunt(Start(14) To Start(14)+10000,"CMAP")+8
For A=0 To 31
PR(A)=Peek(S) : Add S,1
PG(A)=Peek(S) : Add S,1
PB(A)=Peek(S) : Add S,1
Next
For A=0 To 31 : CO(A)=Colour(A)
Next
Screen 7 : Screen To Front 7
Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Screen Width: ";WOS
Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Number of frames: ";NOF
Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Width of each frame: ";WOF
Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Height of each frame: ";HOF
Curs Off
X=0 : Y=0
For A=0 To NOF-1
CONVERT[Start(14)+6+A*WOF*HOF,X,Y]
X=X+WOF : If X+WOF>WOS Then X=0 : Add Y,HOF
Next
F$=Fsel$("ab3:includes/","","Save raw data file")
If F$="" Then End
PSAVE[F$,NOF]
Screen 7 : Locate 1,1 : Print Space$(78)
Locate 1,1 : Centre "All done, select another file, or cancel to quit"
Until 0
Edit
Procedure PSAVE[M$,NO]
L=(NO*WOF*HOF)-1
'
T=0
P=Start(12)
'
S=Start(14)
Doke S,NO
Doke S+2,WOF
Doke S+4,HOF
Add S,6
Add S,L
Trap Bsave M$+".dat",Start(14) To S
If Errtrap
Screen To Front 7 : Screen 7
Locate 1,1 : Print Space$(78)
Locate 1,1 : Centre "Unable to save '"+M$+".dat'"
Wait Key
Edit
End If
N=Start(12)
Screen To Front 7 : Screen 7
Locate 1,1 : Print Space$(78)
Locate 10,1 : Print "Creating palette, please wait "
For A=0 To 31
V=32-A
For Q=0 To 31
Locate 42,1 : Print Using "(###.##% complete)";(A*32+Q)/10.24
R=PR(Q) : G=PG(Q) : B=PB(Q)
R=(R*V)/32 : G=(G*V)/32 : B=(B*V)/32
DQ=10000000
TC=0
For Z=0 To 255
DR=Abs(R-R(Z))
DG=Abs(G-G(Z))
DB=Abs(B-B(Z))
ND=(DR*3)+(DG*3)+(DB*3)
If ND<DQ Then DQ=ND : TC=Z
Next
Doke N,TC*256
Add N,2
Next
Next
Trap Bsave M$+".256pal",Start(12) To N
If Errtrap
Screen To Front 7 : Screen 7
Locate 1,1 : Print Space$(78)
Locate 1,1 : Centre "Unable to save '"+M$+".256pal'"
Wait Key
Edit
End If
End Proc
'
Procedure CONVERT[ST,OX,OY]
Screen To Front 7 : Screen 7
Locate 1,1 : Print Space$(78)
Locate 1,1 : Centre "Converting data..."
Screen 0
Pen 0
For X=OX To OX+WOF-1
For Y=OY To OY+HOF-1
C= Extension_12_044C(X,Y)
Poke ST,C
Add ST,1
Extension_12_036E X,Y,0
Next : Next
End Proc